home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / mac / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Direct3D / Billboard / billboard.frm next >
Text File  |  2001-10-08  |  23KB  |  737 lines

  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   4290
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   5580
  8.    Icon            =   "billboard.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   286
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   372
  13.    StartUpPosition =   3  'Windows Default
  14. End
  15. Attribute VB_Name = "Form1"
  16. Attribute VB_GlobalNameSpace = False
  17. Attribute VB_Creatable = False
  18. Attribute VB_PredeclaredId = True
  19. Attribute VB_Exposed = False
  20. '-----------------------------------------------------------------------------
  21. ' File: Billboard.frm
  22. '
  23. ' Desc: Example code showing how to do billboarding. The sample uses
  24. '       billboarding to draw some trees.
  25. '
  26. '       Note: this implementation is for billboards that are fixed to rotate
  27. '       about the Y-axis, which is good for things like trees. For
  28. '       unconstrained billboards, like explosions in a flight sim, the
  29. '       technique is the same, but the the billboards are positioned slightly
  30. '       different. Try using the inverse of the view matrix, TL-vertices, or
  31. '       some other technique.
  32. '
  33. ' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
  34. '-----------------------------------------------------------------------------
  35.  
  36. Option Explicit
  37.  
  38. '-----------------------------------------------------------------------------
  39. ' Defines, constants, and global variables
  40. '-----------------------------------------------------------------------------
  41. Const NUM_TREES = 200
  42. Const D3DFVF_TREEVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1)
  43. Const NUMTREETEXTURES = 3
  44.  
  45. ' Custom vertex type for the trees
  46. Private Type TREEVERTEX
  47.     p As D3DVECTOR
  48.     color As Long
  49.     tu As Single
  50.     tv As Single
  51. End Type
  52.  
  53. Dim m_bInit As Boolean                  ' Indicates that d3d has been initialized
  54. Dim m_bMinimized As Boolean             ' Indicates that display window is minimized
  55.  
  56.  
  57. '-----------------------------------------------------------------------------
  58. ' Name: Tree
  59. ' Desc: Simple structure to hold data for rendering a tree
  60. '-----------------------------------------------------------------------------
  61. Private Type TREE
  62.     v(3) As TREEVERTEX
  63.     vPos As D3DVECTOR
  64.     iTreeTexture As Long
  65.     iNext As Long
  66.     dist As Single
  67. End Type
  68.  
  69. Private Type HILLVERTEX
  70.     x As Single
  71.     y As Single
  72.     z As Single
  73.     tu As Single
  74.     tv As Single
  75. End Type
  76.     
  77.  
  78. Dim m_vEyePt As D3DVECTOR
  79. Dim m_strTreeTextures(3) As String
  80. Dim m_media As String
  81.  
  82. Dim m_Terrain As CD3DMesh
  83. Dim m_SkyBox  As CD3DMesh              ' Skybox background object
  84. Dim m_TreeVB As Direct3DVertexBuffer8  ' Vertex buffer for rendering a tree
  85. Dim m_TreeTextures(NUMTREETEXTURES)    ' Tree images
  86. Dim m_matBillboardMatrix As D3DMATRIX   ' Used for billboard orientation
  87. Dim m_Trees(NUM_TREES)  As TREE                ' Array of tree info
  88. Dim m_fTime As Single
  89. Dim m_iTreeHead As Long
  90. Dim m_iSortHead As Long
  91.  
  92. '-----------------------------------------------------------------------------
  93. ' Name: Form_Load()
  94. ' Desc:
  95. '-----------------------------------------------------------------------------
  96. Private Sub Form_Load()
  97.     Me.Show
  98.     DoEvents
  99.     
  100.     'Setup defaults
  101.     Init
  102.     
  103.      ' Initialize D3D
  104.     ' Note: D3DUtil_Init will attempt to use D3D Hardware acceleartion.
  105.     ' If it is not available it attempt to use the Software Reference Rasterizer.
  106.     ' If all fail it will display a message box indicating so.
  107.     '
  108.     m_bInit = D3DUtil_Init(Me.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Nothing)
  109.     If Not (m_bInit) Then End
  110.  
  111.     ' Find media and set media directory
  112.     m_media = FindMediaDir("Tree02S.tga")
  113.     D3DUtil_SetMediaPath m_media
  114.     
  115.     ' Initialize Application Data
  116.     OneTimeSceneInit
  117.     
  118.     ' Create and load mesh objects
  119.     InitDeviceObjects
  120.     
  121.     ' Sets the state for those objects and the current D3D device
  122.     ' (setup camera and lights etc)
  123.     RestoreDeviceObjects
  124.     
  125.     ' Start application timer
  126.     DXUtil_Timer TIMER_start
  127.     
  128.     ' Run the simulation forever
  129.     ' See Form_Keydown for exit processing
  130.     Do While True
  131.     
  132.         ' Increment the simulation
  133.         FrameMove
  134.         
  135.         ' Render one image of the simulation
  136.         If Render Then 'Success
  137.             
  138.             ' Present the image to the screen
  139.             D3DUtil_PresentAll g_focushwnd
  140.         End If
  141.         
  142.         ' Allow for events to get processed
  143.         DoEvents
  144.         
  145.     Loop
  146.     
  147. End Sub
  148.  
  149. '-----------------------------------------------------------------------------
  150. ' Name: Form_KeyDown()
  151. ' Desc: Process key messages for exit and change device
  152. '-----------------------------------------------------------------------------
  153. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  154.      
  155.      Dim hr As Long
  156.      
  157.      Select Case KeyCode
  158.         
  159.         Case vbKeyEscape
  160.             Unload Me
  161.             
  162.         Case vbKeyF2
  163.                 
  164.             ' Pause the timer
  165.             DXUtil_Timer TIMER_STOP
  166.             
  167.             ' Bring up the device selection dialog
  168.             ' we pass in the form so the selection process
  169.             ' can make calls into InitDeviceObjects
  170.             ' and RestoreDeviceObjects
  171.             frmSelectDevice.SelectDevice Me
  172.             
  173.             ' Restart the timer
  174.             DXUtil_Timer TIMER_start
  175.             
  176.         Case vbKeyReturn
  177.         
  178.             ' Check for Alt-Enter if not pressed exit
  179.             If Shift <> 4 Then Exit Sub
  180.             
  181.             ' If we are windowed go fullscreen
  182.             ' If we are fullscreen returned to windowed
  183.             If g_d3dpp.Windowed Then
  184.                  hr = D3DUtil_ResetFullscreen
  185.             Else
  186.                  hr = D3DUtil_ResetWindowed
  187.             End If
  188.                              
  189.             ' Call Restore after ever mode change
  190.             ' because calling reset looses state that needs to
  191.             ' be reinitialized
  192.             If (hr = D3D_OK) Then
  193.                 RestoreDeviceObjects
  194.             End If
  195.            
  196.     End Select
  197. End Sub
  198.  
  199.  
  200. '-----------------------------------------------------------------------------
  201. ' Name: Form_Resize()
  202. ' Desc: hadle resizing of the D3D backbuffer
  203. '-----------------------------------------------------------------------------
  204. Private Sub Form_Resize()
  205.     
  206.     ' If D3D is not initialized then exit
  207.     If Not m_bInit Then Exit Sub
  208.     
  209.     ' If we are in a minimized state stop the timer and exit
  210.     If Me.WindowState = vbMinimized Then
  211.         DXUtil_Timer TIMER_STOP
  212.         m_bMinimized = True
  213.         Exit Sub
  214.         
  215.     ' If we just went from a minimized state to maximized
  216.     ' restart the timer
  217.     Else
  218.         If m_bMinimized = True Then
  219.             DXUtil_Timer TIMER_start
  220.             m_bMinimized = False
  221.         End If
  222.     End If
  223.  
  224.     ' Dont let the window get too small
  225.     If Me.ScaleWidth < 10 Then
  226.         Me.width = Screen.TwipsPerPixelX * 10
  227.         Exit Sub
  228.     End If
  229.     
  230.     If Me.ScaleHeight < 10 Then
  231.         Me.height = Screen.TwipsPerPixelY * 10
  232.         Exit Sub
  233.     End If
  234.         
  235.     'reset and resize our D3D backbuffer to the size of the window
  236.     D3DUtil_ResizeWindowed Me.hwnd
  237.     
  238.     'All state get losts after a reset so we need to reinitialze it here
  239.     RestoreDeviceObjects
  240.     
  241. End Sub
  242.  
  243. '-----------------------------------------------------------------------------
  244. ' Name: Form_Unload()
  245. ' Desc:
  246. '-----------------------------------------------------------------------------
  247. Private Sub Form_Unload(Cancel As Integer)
  248.     DeleteDeviceObjects
  249.     End
  250. End Sub
  251.  
  252. ' Simple function to define "hilliness" for terrain
  253. Function HeightField(x As Single, y As Single) As Single
  254.     HeightField = 9 * (Cos(x / 20 + 0.2) * Cos(y / 15 - 0.2) + 1#)
  255. End Function
  256.  
  257. Sub Init()
  258.  
  259.     m_strTreeTextures(0) = "Tree02S.tga"
  260.     m_strTreeTextures(1) = "Tree35S.tga"
  261.     m_strTreeTextures(2) = "Tree01S.tga"
  262.  
  263.     Me.Caption = ("Billboard: D3D Billboarding Example")
  264.     
  265.     Set m_SkyBox = New CD3DMesh
  266.     Set m_Terrain = New CD3DMesh
  267.     Set m_TreeVB = Nothing
  268.  
  269. End Sub
  270.  
  271.  
  272.  
  273. '-----------------------------------------------------------------------------
  274. ' Name: OneTimeSceneInit()
  275. ' Desc: Called during initial app startup, this function performs all the
  276. '       permanent initialization.
  277. '-----------------------------------------------------------------------------
  278. Sub OneTimeSceneInit()
  279.     Dim i As Long
  280.     Dim fTheta As Single, fRadius As Single, fWidth As Single, fHeight As Single
  281.     Dim r As Long, g As Long, b As Long, treecolor As Long
  282.     Rnd (1)
  283.     
  284.     ' Initialize the tree data
  285.     For i = 0 To NUM_TREES - 1
  286.  
  287.         ' Position the trees randomly
  288.         fTheta = 2 * g_pi * Rnd()
  289.         fRadius = 25 + 55 * Rnd()
  290.         m_Trees(i).vPos.x = fRadius * Sin(fTheta)
  291.         m_Trees(i).vPos.z = fRadius * Cos(fTheta)
  292.         m_Trees(i).vPos.y = HeightField(m_Trees(i).vPos.x, m_Trees(i).vPos.z)
  293.  
  294.         ' Size the trees randomly
  295.         fWidth = 1 + 0.2 * (Rnd() - Rnd())
  296.         fHeight = 1.4 + 0.4 * (Rnd() - Rnd())
  297.  
  298.         ' Each tree is a random color between red and green
  299.          r = (255 - 190) + CLng(190 * Rnd())
  300.          g = (255 - 190) + CLng(190 * Rnd())
  301.          b = 0
  302.          treecolor = &HFF000000 + r * 2 ^ 16 + g * 2 ^ 8 + b
  303.  
  304.         m_Trees(i).v(0).p = vec3(-fWidth, 0 * fHeight, 0)
  305.         m_Trees(i).v(0).color = treecolor
  306.         m_Trees(i).v(0).tu = 0: m_Trees(i).v(0).tv = 1
  307.         m_Trees(i).v(1).p = vec3(-fWidth, 2 * fHeight, 0)
  308.         m_Trees(i).v(1).color = treecolor
  309.         m_Trees(i).v(1).tu = 0: m_Trees(i).v(1).tv = 0
  310.         m_Trees(i).v(2).p = vec3(fWidth, 0 * fHeight, 0)
  311.         m_Trees(i).v(2).color = treecolor
  312.         m_Trees(i).v(2).tu = 1:      m_Trees(i).v(2).tv = 1
  313.         m_Trees(i).v(3).p = vec3(fWidth, 2 * fHeight, 0)
  314.         m_Trees(i).v(3).color = treecolor
  315.         m_Trees(i).v(3).tu = 1:      m_Trees(i).v(3).tv = 0
  316.  
  317.         ' Size the trees randomly
  318.         m_Trees(i).iTreeTexture = CLng((NUMTREETEXTURES - 1) * Rnd())
  319.         m_Trees(i).iNext = i + 1
  320.     Next
  321.     
  322.     m_Trees(NUM_TREES - 1).iNext = -1  'use -1 to indicate end of the list
  323.     
  324. End Sub
  325.  
  326.  
  327. '-----------------------------------------------------------------------------
  328. ' Name: Sort
  329. ' Desc: Callback function for sorting trees in back-to-front order
  330. '-----------------------------------------------------------------------------
  331. Sub DoSort()
  332.     Dim i As Long
  333.     Dim dx As Single, dz As Single, dist As Single
  334.     
  335.     'calculate the square of the distance to the eyept
  336.     'to best approximate sort order
  337.     'CONSIDER transforming the position into screen space and sorting on z/w
  338.     For i = 0 To NUM_TREES - 1
  339.         dx = m_Trees(i).vPos.x - m_vEyePt.x
  340.         dz = m_Trees(i).vPos.z - m_vEyePt.z
  341.         m_Trees(i).dist = dx * dx + dz * dz
  342.     Next
  343.     
  344.     Dim iAtU As Long
  345.     Dim iPrevU As Long
  346.     Dim iNextU As Long
  347.     
  348.     iAtU = m_iTreeHead
  349.     iPrevU = -1
  350.     iNextU = -1
  351.     m_iSortHead = -1
  352.     
  353.     Dim z As Long
  354.     Dim q As Long
  355.         
  356.     Do While iAtU <> -1
  357.         dist = m_Trees(iAtU).dist
  358.         
  359.         iNextU = m_Trees(iAtU).iNext
  360.         InsertIntoList iAtU, dist
  361.                 
  362.         
  363.         
  364.         'advance to next item in Unsorted list
  365.         iPrevU = iAtU
  366.         iAtU = iNextU
  367.         
  368.     Loop
  369.      
  370.     m_iTreeHead = m_iSortHead
  371.  
  372.  
  373. End Sub
  374.  
  375.  
  376. Sub InsertIntoList(iNode As Long, dist2 As Single)
  377.     
  378.     
  379.     
  380.     Dim iAtS As Long
  381.     Dim iPrevS As Long
  382.             
  383.     iAtS = m_iSortHead
  384.     iPrevS = -1
  385.     
  386.     'If Sorted list is empty add first node
  387.     If iAtS = -1 Then
  388.         m_iSortHead = iNode
  389.         m_Trees(iNode).iNext = -1
  390.         Exit Sub
  391.     End If
  392.     
  393.     
  394.     'see if we need to add at begining
  395.     If m_Trees(m_iSortHead).dist < dist2 Then
  396.         m_Trees(iNode).iNext = m_iSortHead
  397.         m_iSortHead = iNode
  398.         Exit Sub
  399.     End If
  400.     
  401.     'we dont have an empty list
  402.     'we dont need to add to front of list
  403.     Do While iAtS <> -1
  404.         
  405.         If m_Trees(iAtS).dist < dist2 Then
  406.         
  407.             'add to sorted list
  408.             m_Trees(iNode).iNext = m_Trees(iPrevS).iNext
  409.             m_Trees(iPrevS).iNext = iNode
  410.             Exit Sub
  411.         End If
  412.                 
  413.         'advance to next item in  sorted list
  414.         iPrevS = iAtS
  415.         iAtS = m_Trees(iAtS).iNext
  416.         
  417.     Loop
  418.     
  419.     'must go at end of list
  420.     m_Trees(iPrevS).iNext = iNode
  421.     m_Trees(iNode).iNext = -1
  422.     
  423.     
  424. End Sub
  425.  
  426.  
  427.  
  428.  
  429. '-----------------------------------------------------------------------------
  430. ' Name: FrameMove()
  431. ' Desc: Called once per frame, the call is the entry point for animating
  432. '       the scene.
  433. '-----------------------------------------------------------------------------
  434. Sub FrameMove()
  435.     m_fTime = DXUtil_Timer(TIMER_GETAPPTIME)
  436.  
  437.     ' Get the eye and lookat points from the camera's path
  438.     Dim vUpVec As D3DVECTOR, vEyePt As D3DVECTOR, vLookAtpt As D3DVECTOR
  439.     vUpVec = vec3(0, 1, 0)
  440.     
  441.     vEyePt.x = 30 * Cos(0.8 * (m_fTime + 1))
  442.     vEyePt.z = 30 * Sin(0.8 * (m_fTime + 1))
  443.     vEyePt.y = 4 + HeightField(vEyePt.x, vEyePt.z)
  444.  
  445.     vLookAtpt.x = 30 * Cos(0.8 * (m_fTime + 1.5))
  446.     vLookAtpt.z = 30 * Sin(0.8 * (m_fTime + 1.5))
  447.     vLookAtpt.y = vEyePt.y - 1
  448.  
  449.     ' Set the app view matrix for normal viewing
  450.     Dim matView As D3DMATRIX
  451.     D3DXMatrixLookAtLH matView, vEyePt, vLookAtpt, vUpVec
  452.     g_dev.SetTransform D3DTS_VIEW, matView
  453.  
  454.     ' Set up a rotation matrix to orient the billboard towards the camera.
  455.     Dim vDir As D3DVECTOR
  456.     D3DXVec3Subtract vDir, vLookAtpt, vEyePt
  457.     
  458.     If (vDir.x > 0) Then
  459.         D3DXMatrixRotationY m_matBillboardMatrix, -Atn(vDir.z / vDir.x) + (g_pi / 2)
  460.     Else
  461.         D3DXMatrixRotationY m_matBillboardMatrix, -Atn(vDir.z / vDir.x) - (g_pi / 2)
  462.     End If
  463.     
  464.     ' Sort trees in back-to-front order
  465.     m_vEyePt = vEyePt
  466.     
  467.     
  468.     DoSort
  469.  
  470. End Sub
  471.  
  472.  
  473.  
  474. '-----------------------------------------------------------------------------
  475. ' Name: DrawTrees()
  476. ' Desc:
  477. '-----------------------------------------------------------------------------
  478. Sub DrawTrees()
  479.     Dim i As Long
  480.  
  481.     ' Set diffuse blending for alpha set in vertices.
  482.     g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1  'TRUE
  483.     g_dev.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
  484.     g_dev.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
  485.  
  486.     ' Enable alpha testing (skips pixels with less than a certain alpha.)
  487.     If ((g_d3dCaps.AlphaCmpCaps And D3DPCMPCAPS_GREATEREQUAL) = D3DPCMPCAPS_GREATEREQUAL) Then
  488.         g_dev.SetRenderState D3DRS_ALPHATESTENABLE, 1 'TRUE
  489.         g_dev.SetRenderState D3DRS_ALPHAREF, &H8&
  490.         g_dev.SetRenderState D3DRS_ALPHAFUNC, D3DCMP_GREATEREQUAL
  491.     End If
  492.  
  493.     ' Loop through and render all trees
  494.     'For i = 0 To NUM_TREES
  495.     i = m_iTreeHead
  496.     Do While i <> -1
  497.         
  498.         ' Set the tree texture
  499.         g_dev.SetTexture 0, m_TreeTextures(m_Trees(i).iTreeTexture)
  500.  
  501.         ' Translate the billboard into place
  502.         m_matBillboardMatrix.m41 = m_Trees(i).vPos.x
  503.         m_matBillboardMatrix.m42 = m_Trees(i).vPos.y
  504.         m_matBillboardMatrix.m43 = m_Trees(i).vPos.z
  505.         g_dev.SetTransform D3DTS_WORLD, m_matBillboardMatrix
  506.  
  507.         ' Copy tree mesh into vertexbuffer
  508.         Dim v As TREEVERTEX
  509.         D3DVertexBuffer8SetData m_TreeVB, 0, Len(v) * 4, 0, m_Trees(i).v(0)
  510.         
  511.  
  512.         ' Render the billboards one at a time
  513.         ' CONSIDER: putting this in larger vertex buffers sorted by texture
  514.         g_dev.SetStreamSource 0, m_TreeVB, Len(v)
  515.         g_dev.SetVertexShader D3DFVF_TREEVERTEX
  516.         g_dev.DrawPrimitive D3DPT_TRIANGLESTRIP, 0, 2
  517.     
  518.         i = m_Trees(i).iNext
  519.     Loop
  520.     'Next
  521.  
  522.     ' Restore state
  523.     Dim matWorld As D3DMATRIX
  524.     
  525.     D3DXMatrixIdentity matWorld
  526.     g_dev.SetTransform D3DTS_WORLD, matWorld
  527.     g_dev.SetRenderState D3DRS_ALPHATESTENABLE, 0 '   FALSE
  528.     g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 0 '  FALSE
  529.  
  530. End Sub
  531.  
  532.  
  533.  
  534. '-----------------------------------------------------------------------------
  535. ' Name: Render()
  536. ' Desc: Called once per frame, the call is the entry point for 3d
  537. '       rendering. This function sets up render states, clears the
  538. '       viewport, and renders the scene.
  539. '-----------------------------------------------------------------------------
  540. Function Render() As Boolean
  541.  
  542.     Dim matView As D3DMATRIX, matViewSave As D3DMATRIX, hr As Long
  543.     
  544.     Render = False
  545.     'See what state the device is in.
  546.     hr = g_dev.TestCooperativeLevel
  547.     If hr = D3DERR_DEVICENOTRESET Then
  548.         On Error Resume Next
  549.         g_dev.Reset g_d3dpp
  550.         If (Err.Number = D3D_OK) Then
  551.             RestoreDeviceObjects
  552.         End If
  553.         On Error GoTo 0
  554.     ElseIf hr <> 0 Then
  555.         Exit Function 'dont bother rendering if we are not ready yet
  556.     End If
  557.     Render = True
  558.     ' Clear the viewport
  559.     g_dev.Clear ByVal 0, ByVal 0, D3DCLEAR_ZBUFFER, &H0, 1, 0
  560.  
  561.     ' Begin the scene
  562.     g_dev.BeginScene
  563.  
  564.     ' Render the Skybox
  565.     
  566.     ' Center view matrix for skybox and disable zbuffer
  567.         
  568.     g_dev.GetTransform D3DTS_VIEW, matViewSave
  569.     matView = matViewSave
  570.     matView.m41 = 0: matView.m42 = -0.3: matView.m43 = 0
  571.     g_dev.SetTransform D3DTS_VIEW, matView
  572.     g_dev.SetRenderState D3DRS_ZENABLE, 0 ' FALSE
  573.  
  574.     ' Render the skybox
  575.     m_SkyBox.Render g_dev
  576.  
  577.     ' Restore the render states
  578.     g_dev.SetTransform D3DTS_VIEW, matViewSave
  579.     g_dev.SetRenderState D3DRS_ZENABLE, 1 'TRUE
  580.  
  581.     ' Draw the terrain
  582.     m_Terrain.Render g_dev
  583.  
  584.     ' Draw the trees
  585.     DrawTrees
  586.  
  587.  
  588.         ' End the scene.
  589.     g_dev.EndScene
  590.  
  591.  
  592. End Function
  593.  
  594.  
  595. '-----------------------------------------------------------------------------
  596. ' Name: InitDeviceObjects()
  597. ' Desc: This creates all device-dependant managed objects, such as managed
  598. '       textures and managed vertex buffers.
  599. '-----------------------------------------------------------------------------
  600. Sub InitDeviceObjects()
  601.     Dim i As Long
  602.     Dim v As TREEVERTEX
  603.  
  604.     ' Create the tree textures
  605.     For i = 0 To NUMTREETEXTURES - 1
  606.         Set m_TreeTextures(i) = g_d3dx.CreateTextureFromFileEx(g_dev, m_media + m_strTreeTextures(i), 256, 256, D3DX_DEFAULT, 0, D3DFMT_A1R5G5B5, D3DPOOL_MANAGED, D3DX_DEFAULT, D3DX_DEFAULT, &HFF000000, ByVal 0, ByVal 0)
  607.     Next
  608.     
  609.     ' Create a quad for rendering each tree
  610.     Set m_TreeVB = g_dev.CreateVertexBuffer(4 * Len(v), 0, D3DFVF_TREEVERTEX, D3DPOOL_MANAGED)
  611.  
  612.     ' Load the skybox
  613.     m_SkyBox.InitFromFile g_dev, m_media + "SkyBox2.x"
  614.  
  615.     ' Load the terrain
  616.     m_Terrain.InitFromFile g_dev, m_media + "SeaFloor.x"
  617.     
  618.     
  619.     ' Add some "hilliness" to the terrain
  620.     Dim HillVB As Direct3DVertexBuffer8, NumHillVerts As Long
  621.     Dim HillVerts() As HILLVERTEX
  622.     Set HillVB = m_Terrain.mesh.GetVertexBuffer()
  623.     
  624.     NumHillVerts = m_Terrain.mesh.GetNumVertices
  625.     ReDim HillVerts(NumHillVerts)
  626.  
  627.     D3DVertexBuffer8GetData HillVB, 0, NumHillVerts * Len(HillVerts(0)), 0, HillVerts(0)
  628.     For i = 0 To NumHillVerts - 1
  629.         HillVerts(i).y = HeightField(HillVerts(i).x, HillVerts(i).z)
  630.     Next
  631.     D3DVertexBuffer8SetData HillVB, 0, NumHillVerts * Len(HillVerts(0)), 0, HillVerts(0)
  632.  
  633. End Sub
  634.  
  635.  
  636.  
  637. '-----------------------------------------------------------------------------
  638. ' Name: RestoreDeviceObjects()
  639. ' Desc: Restore device-memory objects and state after a device is created or
  640. '       resized.
  641. '-----------------------------------------------------------------------------
  642. Sub RestoreDeviceObjects()
  643.  
  644.     ' Restore the device objects for the meshes and fonts
  645.     m_Terrain.RestoreDeviceObjects g_dev
  646.     m_SkyBox.RestoreDeviceObjects g_dev
  647.     
  648.     ' Set the transform matrices (view and world are updated per frame)
  649.     Dim matProj As D3DMATRIX
  650.     D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, Me.ScaleHeight / Me.ScaleWidth, 1, 100
  651.     g_dev.SetTransform D3DTS_PROJECTION, matProj
  652.  
  653.     ' Set up the default texture states
  654.     g_dev.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_SELECTARG1
  655.     g_dev.SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
  656.     g_dev.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1
  657.     g_dev.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE
  658.     g_dev.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
  659.     g_dev.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
  660.     g_dev.SetTextureStageState 0, D3DTSS_ADDRESSU, D3DTADDRESS_CLAMP
  661.     g_dev.SetTextureStageState 0, D3DTSS_ADDRESSV, D3DTADDRESS_CLAMP
  662.  
  663.     g_dev.SetRenderState D3DRS_DITHERENABLE, 1 'TRUE
  664.     g_dev.SetRenderState D3DRS_ZENABLE, 1      'TRUE )
  665.     g_dev.SetRenderState D3DRS_LIGHTING, 0     'FALSE )
  666.     
  667. End Sub
  668.  
  669.  
  670.  
  671. '-----------------------------------------------------------------------------
  672. ' Name: InvalidateDeviceObjects()
  673. ' Desc: Called when the device-dependant objects are about to be lost.
  674. '-----------------------------------------------------------------------------
  675. Sub InvalidateDeviceObjects()
  676.  
  677.     m_Terrain.InvalidateDeviceObjects
  678.     m_SkyBox.InvalidateDeviceObjects
  679.     
  680. End Sub
  681.  
  682.  
  683.  
  684. '-----------------------------------------------------------------------------
  685. ' Name: DeleteDeviceObjects()
  686. ' Desc: Called when the app is exitting, or the device is being changed,
  687. '       this function deletes any device dependant objects.
  688. '-----------------------------------------------------------------------------
  689. Sub DeleteDeviceObjects()
  690.     
  691.     Dim i As Long
  692.     
  693.     m_Terrain.Destroy
  694.     m_SkyBox.Destroy
  695.  
  696.     For i = 0 To NUMTREETEXTURES - 1
  697.         Set m_TreeTextures(i) = Nothing
  698.     Next
  699.  
  700.     m_bInit = False
  701.  
  702. End Sub
  703.  
  704.  
  705.  
  706.  
  707. '-----------------------------------------------------------------------------
  708. ' Name: FinalCleanup()
  709. ' Desc: Called before the app exits, this function gives the app the chance
  710. '       to cleanup after itself.
  711. '-----------------------------------------------------------------------------
  712. Sub FinalCleanup()
  713.     Set m_Terrain = Nothing
  714.     Set m_SkyBox = Nothing
  715. End Sub
  716.  
  717.  
  718. '-----------------------------------------------------------------------------
  719. ' Name: VerifyDevice()
  720. ' Desc: Called during device intialization, this code checks the device
  721. '       for some minimum set of capabilities
  722. '-----------------------------------------------------------------------------
  723. Public Function VerifyDevice(usageflags As Long, format As CONST_D3DFORMAT) As Boolean
  724.     
  725.     ' This sample uses alpha textures and/or straight alpha. Make sure the
  726.     ' device supports them
  727.     
  728.     If ((g_d3dCaps.TextureCaps And D3DPTEXTURECAPS_ALPHAPALETTE) = D3DPTEXTURECAPS_ALPHAPALETTE) Then VerifyDevice = True
  729.     If ((g_d3dCaps.TextureCaps And D3DPTEXTURECAPS_ALPHA) = D3DPTEXTURECAPS_ALPHA) Then VerifyDevice = True
  730.     
  731. End Function
  732.  
  733.  
  734.  
  735.  
  736.  
  737.